(in-package :cl-user)
;; (update *blogs*)

(require :s-utils)
(require :s-xml)
(require :cl-ppcre)
(require :drakma)
(require :cl-who)
(require :hunchentoot)

(defclass user ()
  ((email :accessor email :initarg :email)
   (name :accessor name :initarg :name)))

;; check if the two given users are the same user If two users have
;; the same email address, then we regard them as the same user.
(defmethod user-eq ((a user) (b user))
  (string= (email a) (email b)))

(defclass blog ()
  ((url :accessor url :initarg :url)
   (name :accessor name :initarg :name)
   (users :accessor users :initform '()) ;; Which users are interesting in these blog
   (entries :accessor entries :initform '())))


;; Check if the given two blogs are the same blog. If they have the
;; same url, then we regard them as the same.
(defmethod blog-eq ((a blog) (b blog))
  (string= (url a) (url b)))


(defvar *server* (hunchentoot:start-server :port 8008))

(push (hunchentoot:create-regex-dispatcher "^/$" 'list-blogs) hunchentoot:*dispatch-table*)
(push (hunchentoot:create-regex-dispatcher "^/add-monitor" 'add-monitor) hunchentoot:*dispatch-table*)

(defun add-monitor ()
  (let* ((blog-url (hunchentoot:parameter "url"))
         (blog-name (hunchentoot:parameter "name"))
         (username (hunchentoot:parameter "username"))
         (email (hunchentoot:parameter "email"))
         (new-blog (make-instance 'blog :url blog-url :name blog-name))
         (new-user (make-instance 'user :email email :name username)))
    (let ((existing-blog (find new-blog *blogs* :test #'blog-eq)))
      (unless (null existing-blog)
        (associate-user-with-blog new-user existing-blog))
      (when (null existing-blog)
        (push new-blog *blogs*)
        (associate-user-with-blog new-user new-blog))))
    (hunchentoot:redirect "/"))

(defun add-monitor-test ()
  (let* ((blog-url "test")
         (blog-name "asfasdf")
         (username "asdf")
         (email "asdf")
         (new-blog (make-instance 'blog :url blog-url :name blog-name))
         (new-user (make-instance 'user :email email :name username)))
    (let ((existing-blog (find new-blog *blogs* :test #'blog-eq)))
      (unless (null existing-blog)
        (print "not null existing-blog")
        (associate-user-with-blog new-user existing-blog))
      (when (null existing-blog)
        (print "null existing-blog")
        (push new-blog *blogs*)
        (associate-user-with-blog new-user new-blog)))))

;; (add-monitor-test)
    

(setf hunchentoot:*hunchentoot-default-external-format* hunchentoot::+utf-8+)
(setf hunchentoot:*default-content-type* "text/html; charset=utf-8")

(defun list-blogs ()
  (cl-who:with-html-output-to-string (str)
    (:html
     (:head (:title "MSN spaces comments watcher"))
     (:body
      (:form :action "/add-monitor" :method "post"
             (:div "url:" (:input :type "text" :name "url"))
             (:div "name:" (:input :type "text" :name "name"))
             (:div "email:" (:input :type "text" :name "email"))
             (:div "what's your name: " (:input :type "text" :name "username"))
             (:input :type "submit" :value "save"))

      (:ol
       (dolist (blog *blogs*)
         (cl-who:htm (:li (:a :href (url blog) (cl-who:str (name blog))))
                     (:h2 (cl-who:str "Who are intresting in this blog?"))
                     (:ol (dolist (x (users blog))
                            (cl-who:htm
                             (:li (cl-who:str (email x))
                                  (cl-who:str "    ")
                                  (cl-who:str (name x))))))
                     (:h2 (cl-who:str "Articles List"))
                     (:ol
                      (dolist (entry (entries blog))
                        (cl-who:htm (:li (:a :href (entry-link entry)
                                             (cl-who:str (entry-title entry))))
                                    (cl-who:str (entry-comment-num entry))))))))
      (cl-who:str "Powered by ")
      (:img :src "http://www.htg1.de/hunchentoot/hunchentoot10.png")
      (:img :src "http://www.sbcl.org/sbclbutton.png")
      (:img :src "http://lisperati.com/lisplogo_alien_128.png")
      ))))

(defvar *debug* nil)

(defvar *blogs* '())

(defun reset-blogs ()
  (setq *blogs* '()))

(defun add-blog (blog)
  (push blog *blogs*))

(defun show-blogs ()
  (dolist (blog *blogs*)
    (print (url blog))))

;; (reset-blogs)
;; (add-blog (make-instance 'blog :url "http://spaceforshzhang.spaces.live.com/feed.rss" :name "zhangsuheng"))
;; (add-blog (make-instance 'blog :url "http://cfksunquan.spaces.live.com/feed.rss" :name "qsun"))
;; (add-blog (make-instance 'blog :url "http://fantasyy.spaces.live.com/feed.rss" :name "Lao Yang"))
;; (add-blog (make-instance 'blog :url "http://rss.slashdot.org/Slashdot/slashdot" :name "slashdot"))

(defun new-user (name email)
  (make-instance 'user :name name
                 :email email))

(defun associate-user-with-blog (user blog)
  (unless (find user (users blog) :test #'user-eq)
    (push user (users blog))))

;(push (new-user "Quan Sun" "cfk.quan@gmail.com") (users (car *blogs*)))

;; (update *blogs*)
(defun update (blogs)
  (dolist (address blogs)
    (update-blog address)))

(defun != (a b)
  (not (= a b)))

(defun get-entry-num (comment-rss)
  (cond ((null comment-rss) 0)
        (t
         (when *debug* (print "get-entry"))
         (length (remove-if-not #'(lambda (x)
                                    (when *debug*
                                      (if (listp x) (print (car x))))
                                    (if (listp x)
                                        (eq (car x) :|item|)
                                        nil))
                                (car (cdr (s-xml:parse-xml (make-string-input-stream (drakma:http-request comment-rss))))))))))

(defun update-comments (blogs)
  (dolist (blog blogs)
    (when *debug* (print (concatenate 'string "retrieveing" (url blog))))
    (dolist (entry (entries blog))
      (let ((current-num (get-entry-num (entry-comment-rss entry)))
            (old-num (entry-comment-num entry)))
        (when (!= current-num
                  old-num)
          ;;(push blog updated-blog)
          ;;1(push entry updated-entry)
          (inform-email-update blog entry)
          (setf (entry-comment-num entry) current-num)
          (print "updated: ")
          (print current-num))))))



(defun find-user (user-name)
  (find user-name *alerts-users* :key #'name :test #'string=))

;; (watch-blog "Quan Sun" 
(defun watch-blog (user-name blog)
  (push user-name (users blog)))

;; TODO
(defun inform-email-update (blog entry)
  (let ((message (concatenate 'string "Your favourite blog: " (url blog) " has been commented. Entry: " (entry-link entry))))
    (dolist (user (users blog))
      (inform-email (email user) (name user) message))))

(defun inform-email (email user message)
  (print email)
  (print user)
  (print message))

(defun inform-user (user message)
  (inform-email (email user) (name user) message))

(defun inform-users (blog message)
  (dolist (user (users blog))
    (inform-user (find-user user) message)))

;; (retrieve-rss nil)
(defmacro retrieve-rss (rss-url)
  `(car (cdr (s-xml:parse-xml (retrieve ,rss-url)))))

;; update if there are new articles on the given blog
(defun update-blog (blog)
  (let ((url (url blog))
        (old-entries (entries blog)))
    (when *debug* (print url))
    (dolist (entry (parse-rss-items (retrieve-rss url)))
      (unless (find entry old-entries :test #'(lambda (a b) (string= (entry-link a) (entry-link b))))
        (push  entry (entries blog))))))

(defun test-parse-rss ()
  (with-open-file (rss-stream "feed.rss")
    (s-xml:parse-xml rss-stream)))

(defun retrieve (blog-url)
  (when *debug* (print "retriving"))
  (make-string-input-stream
   ;;(multiple-value-bind (a b c d e f g) (drakma:http-request url)))))
   (drakma:http-request blog-url)))

;; (get-rss-title (retrieve-rss nil))
(defun get-rss-title (rss)
  (getf (car (cdr rss)) :|title|))

;; (get-description (retrieve-rss  nil))
(defun get-description (rss)
  (getf (car (cdr (cdr rss))) :|description|))

(defun parse-rss-items (rss)
  (let ((items '()))
    (dolist (element rss)
      (when (listp element) 
        (let ((entry-type (car element)))
          (if (eq entry-type :|item|) (push (create-item element) items)))))
    items))

(defun create-item (item)
  (parse-item item))

(defun parse-item (item)
  (let ((parsed-item '()))
    (dolist (element (cdr item))
      (let ((name (car element))
            (attribute (car (cdr element))))
        (cond ((eq name :|link|) (setf (getf parsed-item :link) attribute))
              ((eq name :|comments|) (setf (getf parsed-item :comment) attribute))
              ((eq name :|title|) (setf (getf parsed-item :title) attribute))
              ((eq name '|wfw|:|commentRss|) (setf (getf parsed-item :comment-rss) attribute)))))
    (make-instance 'entry 
                   :title (getf parsed-item :title)
                   :link (getf parsed-item :link)
                   :comment (getf parsed-item :comment)
                   :comment-rss (getf parsed-item :comment-rss)
                   :pubdate (getf parsed-item :pubdate))))

;; entry
(defclass entry ()
  ((title :accessor entry-title :initarg :title)
   (link :accessor entry-link :initarg :link)
   (comment :accessor entry-comment :initarg :comment)
   (comment-rss :accessor entry-comment-rss :initarg :comment-rss)
   (comment-num :accessor entry-comment-num :initform 0)
   (pubdate :accessor entry-pubdate :initarg :pubdate)))


;; (entry-title (car (parse-rss-items (retrieve-rss nil))))

(defun find-blog-comment (comment-s-exp)
  (labels ((check (x)
             (if (and (listp x) 
                      (listp (car x))
                      (= (length (car x)) 3))
                 (string= (car (cdr (cdr (car x)))) "blogCommentText")
                 nil)))
    (if (null comment-s-exp) 
        nil
        (if (listp comment-s-exp)
            (if (check comment-s-exp)
                comment-s-exp
                (find-blog-comment (cdr comment-s-exp)))
            nil))))
    
        

